perm filename FILLX.FAI[NEW,LCS] blob
sn#166870 filedate 1975-07-01 generic text, type T, neo UTF8
00100 TITLE FILL
00200 ENTRY FILLER,LINES,PLOT,PLOTS
00300 DEFINE FLOAT(N)
00400 < TLC N,232000
00500 FADR N,N >
00600 DEFINE FIXX(N)
00700 < JUMPGE N,.+5
00800 MOVNS N
00900 FIX N,233000
01000 MOVNS N
01100 CAIA
01200 FIX N,233000 > ; TO FIX IT LIKE 'IFIX' DOES.
01300
01400 KK←2 ↔ L←3 ↔ LE←4 ↔ T←5 ↔ J←1
01500 RL←6 ↔ RJ←7 ↔ B←0 ↔ H←11 ↔ JK←10
01600 HG←12 ↔ D←13 ↔ AL←14 ↔ JJ←15
01700
01800 ; SUBROUTINE FILLER(Q,M)
01900 FILLER: 0
02000 MOVEM 16,SV16#
02100 HRRZ J,(16)
02200 HRRZM J,SVQ#
02300 HRRZ T,@1(16)
02400 HRRZM T,SVM# ; KK=NE(1)
02500 HRRZ KK,2(J)
02600 ADDI KK,-1(J)
02700 ; DO 4 K=2,KK
02800 HRRZI L,2(J)
02900 ; IF(NE(K).NE.3)GO TO 11
03000 L4: ADDI L,3
03100 HRRZ T,(L)
03200 L11: SETZM (L)
03300 CAIN T,3
03400 ; NE(K)=-1
03500 SETOM (L)
03600 ; GO TO 4
03700 ; 11 NE(K)=0
03800 ; 4 CONTINUE
03900 CAIGE L,(KK)
04000 JRST L4
04100 ; RLFT=10000
04200 MOVE RL,[=10000.0]
04300 ; RT=-10000
04400 MOVN RJ,[=10000.0]
04500 ; B=RT
04600 MOVE B,RJ
04700 ; DO 12 K=1,KK
04800 HRRZI L,-3(J)
04900 ; H=IFIX(Q(K))
05000 L12: ADDI L,3
05100 MOVE H,(L)
05200 FIXX(H)
05300 FLOAT(H)
05400 ; IF(H.LT.RLFT)RLFT=H
05500 CAMGE H,RL
05600 MOVE RL,H
05700
05800 ; IF(H.GT.RT)RT=H
05900 CAMLE H,RJ
06000 MOVE RJ,H
06100 ; IF(H.EQ.B)NE(K)=-1
06200 CAMN H,B
06300 SETOM 2(L)
06400 ; B=H
06500 MOVE B,H
06600 ; Q(K)=H
06700 MOVEM H,(L)
06800 ; 12 R(K)=IFIX(R(K))
06900 MOVE T,1(L)
07000 FIXX(T)
07100 FLOAT(T)
07200 MOVEM T,1(L)
07300 CAIGE L,-2(KK)
07400 JRST L12
07500 ; NE(KK+1)=-1
07600 SETOM 3(KK)
07700
07800 ; LRT=RT
07900 FIXX(RJ)
08000 MOVEM RJ,LRT#
08100 ; JA=3
08200 HRRZI T,3
08300 HRRZM T,JA#
08400
08500
08600 ; 124 LEFT=RLFT
08700 L124: MOVE LE,RL
08800 FIXX(LE)
08900 ; 51 J=LEFT
09000 L51: MOVE J,LE
09100 ; 42 RJ=J+.001
09200 L42: MOVE RJ,J
09300 FLOAT(RJ)
09400 FADR RJ,[=0.001]
09500 ; JCONT=0
09600 SETZM JCONT#
09700 ; LEFT=J
09800 MOVE LE,J
09900
10000 ; JJ=-1
10100 SETO JJ,
10200 ; ALT=-10000.
10300 MOVN AL,[=10000.0]
10400 ; 200 DO 45 L=2,KK
10500 HRRZ L,SVQ
10600 L45: ADDI L,3
10700 CAILE L,-2(KK)
10800 JRST L455
10900 ; IF(NE(L).NE.0)GO TO 45
11000 SKIPE 2(L)
11100 JRST L45
11200 ; IF(MISS(L,RJ,Q))GO TO 45
11300 CAML RJ,-3(L)
11400 JRST L201
11500 CAMLE RJ,(L)
11600 JRST L202
11700 L201: CAMGE RJ,(L)
11800 CAMG RJ,-3(L)
11900 JRST L45
12000 ; H=HGHT(L,RJ,Q,R)
12100 L202: MOVE H,-2(L)
12200 CAMN H,1(L)
12300 JRST RET
12400 MOVNS H
12500 FADR H,1(L)
12600 MOVE D,-3(L)
12700 MOVNS T,D
12800 FADR T,RJ
12900 FADR D,(L)
13000 FMPR H,T
13100 FDVR H,D
13200 FADR H,-2(L)
13300 ; IF(H.LT.ALT)GO TO 45
13400 RET: CAMGE H,AL
13500 JRST L45
13600
13700 ; ALT=H
13800 MOVE AL,H
13900 ; JJ=L
14000 HRRZI JJ,(L)
14100 ; 45 CONTINUE
14200 JRST L45
14300 ; IF(JJ)GO TO 43
14400 L455: JUMPL JJ,L43
14500 ; JCONT=-1
14600 SETOM JCONT
14700 ; LEFT=J
14800 MOVE LE,J
14900 ; 46 JA=3
15000 L46: HRRZI T,3
15100 HRRZM T,JA
15200 ; JORD=-1
15300 SETOM JORD#
15400 ; 52 KN=Q(JJ)
15500 L52: MOVE T,(JJ)
15600 FIXX(T)
15700 MOVEM T,KN#
15800 ; KL=Q(JJ-1)
15900 MOVE T,-3(JJ)
16000 FIXX(T)
16100
16200 MOVEM T,KL#
16300 ; IF(KN.LT.KL)KN=KL
16400 CAMLE T,KN
16500 MOVEM T,KN
16600 ; 50 I=J
16700 L50: MOVEM J,I#
16800 ; 102 RJ=I+.01
16900 L102: MOVE RJ,I
17000 FLOAT(RJ)
17100 FADR RJ,[=0.1] ;6/11/75 ←←**↑↑ WAS 0.01 -- CHECK TIGHT CASES!!
17200 ; ALT=HGHT(JJ,RJ,Q,R)
17300 MOVE AL,-2(JJ)
17400 CAMN AL,1(JJ)
17500 JRST RET2
17600 MOVNS AL
17700 FADR AL,1(JJ)
17800 MOVE D,-3(JJ)
17900 MOVNS T,D
18000 FADR T,RJ
18100 FADR D,(JJ)
18200 FMPR AL,T
18300 FDVR AL,D
18400 FADR AL,-2(JJ)
18500 ; B=-10000
18600 RET2: MOVN B,[=10000.0]
18700 ; JK=-1
18800 SETO JK,
18900 ; XALT=ALT+.001
19000 MOVE T,AL
19100 FADR T,[=0.001]
19200 MOVEM T,XALT#
19300
19400 ; ZALT=ALT
19500 MOVEM AL,ZALT#
19600 ; 400 DO 47 L=2,KK
19700 MOVE L,SVQ
19800 L47: ADDI L,3
19900 CAILE L,-2(KK)
20000 JRST L477
20100 ; IF(L.EQ.JJ.OR.MISS(L,RJ,Q).OR.NE(L).LT.0)GO TO 47
20200 CAME L,JJ
20300 SKIPGE 2(L)
20400 JRST L47
20500 CAML RJ,-3(L)
20600 JRST L475
20700 CAMLE RJ,(L)
20800 JRST L476
20900 L475: CAMGE RJ,(L)
21000 CAMG RJ,-3(L)
21100 JRST L47
21200 ; H=HGHT(L,RJ,Q,R)
21300 L476: MOVE H,-2(L)
21400 CAMN H,1(L)
21500 JRST RET3
21600 MOVNS H
21700 FADR H,1(L)
21800 MOVE D,-3(L)
21900 MOVNS T,D
22000 FADR T,RJ
22100 FADR D,(L)
22200 FMPR H,T
22300 FDVR H,D
22400 FADR H,-2(L)
22500 ; IF(H.GT.XALT)GO TO 47
22600 RET3: CAMG H,XALT
22700
22800 ; IF(H.LE.B)GO TO 47
22900 CAMG H,B
23000 JRST L47
23100 ; B=H
23200 MOVE B,H
23300 ; JK=L
23400 HRRZI JK,(L)
23500 ; 47 CONTINUE
23600 JRST L47
23700 ; IF(JK)GO TO 48
23800 L477: JUMPL JK,L48
23900 ; 300 IF(ZALT-B.GT..001.OR.I.NE.J)GO TO 59
24000 MOVN T,B
24100 FADR T,ZALT
24200 CAMG T,[=0.001]
24300 CAME J,I
24400 JRST L59
24500 ; JX=Q(JK)
24600 MOVE T,(JK)
24700 FIXX(T)
24800 ; IF(JX.GT.KN)GO TO 60
24900 CAMLE T,KN
25000 JRST L60
25100 ; JX=Q(JK-1)
25200 MOVE T,-3(JK)
25300 FIXX(T)
25400 ; IF(JX.LT.KN)GO TO 59
25500 CAMGE T,KN
25600 JRST L59
25700 ; 60 L=JJ
25800 L60: MOVE L,JJ
25900 ; JJ=JK
26000 MOVE JJ,JK
26100 ; JK=L
26200 MOVE JK,L
26300 ; KN=JX
26400 MOVEM T,KN
26500
26600 ; 59 IF(ALT-B.LT.2)GO TO 62
26700 L59: MOVN T,B
26800 FADR T,AL
26900 CAMGE T,[=2.0]
27000 JRST L62
27100 ; ALT=ALT-1
27200 HRLZI T,576400
27300 FADR AL,T
27400 ; B=B+1
27500 HRLZI T,201400
27600 FADR B,T
27700 ; 62 IF(JORD)GO TO 103
27800 L62: SKIPGE JORD
27900 JRST L103
28000 ; H=B
28100 MOVE H,B
28200 ; B=ALT
28300 MOVE B,AL
28400 ; ALT=H
28500 MOVE AL,H
28600 ; IF(JK.NE.NK.AND.ABS(ALT-B).GT.5.)JA=3
28700
28800 CAMN JK,NK#
28900 JRST L103
29000 MOVN T,B
29100 FADR T,AL
29200 SKIPGE T
29300 MOVNS T
29400 CAMG T,[5.0]
29500 JRST L103
29600 HRRZI T,3
29700 HRRZM T,JA
29800 ; 103 CALL LINES(RJ,ALT,JA)
29900 L103: MOVEM RJ,SVRJ#
30000 MOVEM AL,SVAL#
30100 MOVEM B,SVB#
30200 HRRZI 16,SVAC
30300 BLT 16,SVAC+15
30400 JSA 16,LINES
30500 JUMP SVRJ
30600 JUMP SVAL
30700 JUMP JA
30800 ; 100 CALL LINES(RJ,B,2)
30900 JSA 16,LINES
31000 JUMP SVRJ
31100 JUMP SVB
31200 JUMP [2]
31300 HRLZI 16,SVAC
31400 BLT 16,15
31500 ; NK=JK
31600 MOVEM JK,NK
31700
31800 ; JORD=-JORD
31900 MOVNS JORD
32000 ; NE(JK)=1
32100 HRRZI T,1
32200 HRRZM T,2(JK)
32300 ; NE(JJ)=-1
32400 SETOM 2(JJ)
32500 ; JA=2
32600 HRRZI T,2
32700 HRRZM T,JA
32800 ; I=I+M
32900 MOVE T,SVM
33000 ADDB T,I
33100 ; IF(I.LT.KN)GO TO 102
33200 CAMGE T,KN
33300 JRST L102
33400 ; L=1
33500 HRRZI L,3
33600 ; IF(KN.EQ.KL)L=-1
33700 MOVE T,KN
33800 CAMN T,KL
33900 HRROI L,-3
34000 ; JJ=JJ+L
34100 ADD JJ,L
34200 ; J=0
34300 SETZ J,
34400 ; IF(L)J=-1
34500 SKIPGE L
34600 HRROI J,-3
34700 ; IF(KN+M.GT.Q(JJ+J).OR.JJ.GT.KK.OR.NE(JJ).NE.0)GO TO 124
34800 SKIPN 2(JJ)
34900 CAILE JJ,-2(KK)
35000 JRST L124
35100 ADD T,SVM
35200 FLOAT(T)
35300 HRRZI HG,(JJ)
35400 ADD HG,J
35500 CAMLE T,(HG)
35600 JRST L124
35700 ; J=I
35800 MOVE J,I
35900 ; GO TO 52
36000 JRST L52
36100 ; 48 JA=3
36200 L48: HRRZI T,3
36300 HRRZM T,JA
36400 ; 43 J=LEFT+M
36500 L43: MOVE J,LE
36600 ADD J,SVM
36700 ; IF(J.LE.LRT)GO TO 42
36800 CAMG J,LRT
36900 JRST L42
37000 ; IF(JCONT)GO TO 51
37100 SKIPGE JCONT
37200 JRST L51 ; END
37300 MOVE 16,SV16
37400 JRA 16,2(16)
37500 SVAC: BLOCK 16
37600
37700 EXTERNAL DST,PLTR,DPY,.COMM.
37800 ; SUBROUTINE LINES(A,B,L)
37900 ; COMMON/DST/BB,CC
38000 ; COMMON /SIZ/RSZ,JCEN,KCEN /FL/IC,NZ,NX,RZ,XGP
38100 ; COMMON/DL/IXRX,SAVER,AA /PLTR/IPLT,RHT,DIS
38200 ; COMMON R2,JA,CENTR,JB,RJQ(20),JQ(20)
38300 ; COMMON/DPY/JJ(4000),WDS(250),MEDIT,IGO
38400 ; EQUIVALENCE (ITOP,JJ(3999)),(IBOT,JJ(4000))
38500 ; 1,(JJ2,JJ(2))
38600 ; DATA BB/.008/,CC/3.5/
38700 ;C SET XGP TO 1200.0 FOR MARGIN IN XEROX COPIES
38800
38900 M←2 ↔ NX←3 ↔ K←4
39000
39100 LINES: 0
39200 ; GO TO 23
39300 JRST L23
39400 ;22 IF(JQ(1).NE.0)GO TO 23
39500 L22: SKIPE PLTR+=27
39600 JRST L23
39700 ; IF(CC.EQ.1000)GO TO 23
39800 MOVSI T,212764
39900 CAMN T,DST+1
40000 JRST L23
40100 ; B=B*(CC-BB*ABS(A))
40200 MOVE T,@(16)
40300 MOVMS T
40400 FMPR T,DST
40500 FSBR T,DST+1
40600 FMPRM T,@1(16)
40700 MOVNS @1(16)
40800 ;23 IF(IPLT)GO TO 2
40900 L23: SKIPGE PLTR
41000 ;; JRST L2
41100 JRST L9
41110 MOVE T,.COMM.+1 ;IF(JA.EQ.44)RETURN
41120 CAIN T,=44 ;WON'T LOOK AT BARLINES FOR HEIGHT.
41130 JRA 16,3(16)
41200 MOVE T,@1(16)
41300 CAMG T,DPY+1
41400 JRST L333
41500 MOVEM T,DPY+1 ; IF(B.LT.BOT)BOT=B
41600 JRA 16,3(16)
41700 L333: CAMG T,DPY+2
41800 MOVEM T,DPY+2
41900 JRA 16,3(16) ; IF(B.GT.TOP)TOP=B
42000 ;2 IF(IPLT.EQ.-2)RETURN
42100 ;;L2: MOVNI T,2
42200 ;; CAMN T,PLTR
42300 ;; JRA 16,3(16)
42400 ;9 M=ROFF(A*DIS)
42500 L9: MOVE M,@(16)
42600 FMPR M,PLTR+2
42700 SKIPGE M
42800 FADR M,[-=1.0]
42900 FADR M,[=0.5]
43000 FIXX(M)
43100 MOVEM M,MM#
43200 ; N=ROFF(B*RHT)
43300 MOVE NX,@1(16)
43400 FMPR NX,PLTR+1
43500 SKIPGE NX
43600 FADR NX,[-=1.0]
43700 FADR NX,[=0.5]
43800 FIXX(NX)
43900 MOVEM NX,NN#
44000 ;8 CALL PLOT(M,N,L)
44100 L8: MOVE T,@2(16)
44200 MOVEM T,LL#
44300 JSA 16,PLOT
44400 JUMP MM
44500 JUMP NN
44600 JUMP LL
44700 ; END
44800 JRA 16,3(16)
44900
45000 EXTERNAL OUTF,PUTFIL,FASTOU,FINFIL,EXIT,PAC
45100 LX: 0
45200 N: BLOCK =128
45300 PLOT: 0 ;SUBROUTINE PLOT(I,J,K)
45400 MOVE 4,OUTF ;COMMON /OUTF/JJ
45500 CAMN 4,[-1] ;DIMENSION N(148)
45600 JRST PL4 ;IF(JJ.EQ.-1)GO TO 4
45700 MOVEI 7,1 ;L=1
45800 MOVEM 7,LX
45900 MOVEI 4,=127 ;N(1)=127
46000 MOVEM 4,N
46100 MOVE 4,[ASCIZ/" "/] ;IF(JJ.EQ.' ')JJ='PLT'
46200 CAME 4,OUTF
46300 JRST PLB
46400 MOVE 4,[ASCIZ/"PLT"/]
46500 MOVEM 4,OUTF
46600 PLB: JSA 16,PUTFIL ;CALL PUTFIL(JJ)
46700 JUMP OUTF
46800 SETOM OUTF ;JJ=-1
46900 PL4: MOVE 5,@2(16) ;4 IF(K.EQ.99)GO TO 1
47000 CAIN 5,=99
47100 JRST PL1
47200 AOS LX ;L=L+1
47300 MOVEI 7,N
47400 ADD 7,LX ;CALL PAC(N(L),I)[SEE MSFAI.FAI]
47500 HRRZ 4,2(16)
47600 HRR 5,@4
47700 LSHC 5,-10
47800 HRRZ 4,1(16)
47900 HRR 5,@4
48000 LSHC 5,-16
48100 HRRZ 4,(16)
48200 HRR 5,@4
48300 LSHC 5,-16
48400 MOVEM 6,-1(7)
48500
48600 MOVE 7,LX
48700 CAIGE 7,=128 ;3 IF(L.LT.128)RETURN
48800 JRA 16,3(16)
48900 JSA 16,FASTOU ;2 CALL FASTOU(N,128)
49000 JUMP N
49100 JUMP [=128]
49200 MOVEI 7,1 ;L=1
49300 MOVEM 7,LX
49400 JRA 16,3(16) ;RETURN
49500 PL1: MOVE 5,LX ;1 N(1)=L
49600 MOVEM 5,N
49700 MOVEI 7,N ;J=N(L)
49800 ADD 7,5
49900 MOVE 7,-1(7)
50000 MOVEM 7,@1(16)
50100 PL100: MOVEI 4,N ;DO 100 JJ=L,128
50200 ADD 4,5 ;100 N(JJ)=J
50300 MOVEM 7,-1(4)
50400 CAIGE 5,=128
50500 AOJA 5,PL100
50600 JSA 16,FASTOU ;CALL FASTOU(N,128)
50700 JUMP N
50800 JUMP [=128]
50900 JSA 16,FINFIL ;CALL FINFIL
51000 SETZM OUTF ;JJ=0
51100 JSA 16,EXIT ;CALL EXIT
51200
51300 PLOTS: 0
51400 JRA 16,1(16) ; DUMMY ROUTINE
51500 END